Sub 표변환()

    Dim i As Long
    Dim 마지막행 As Long
    Dim 복사위치 As Range
    
    마지막행 = Range("B10000").End(xlUp).Row
    
    For i = 4 To 마지막행 Step 3
    
        Set 복사위치 = Cells(Rows.Count, "D").End(xlUp).Offset(1)
    
        Range("B" & i & ":B" & i + 2).Copy
        복사위치.PasteSpecial Transpose:=True
        
    Next

End Sub